home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac-Source 1994 July
/
Mac-Source_July_1994.iso
/
Updates, etc.
/
PG PRO⁄PG Lite Demos
/
PG Writer π
/
Font.FLTR
< prev
next >
Wrap
Text File
|
1994-03-28
|
8KB
|
248 lines
'===============================================================================
'= Copyright 1992 Staz™ Software, Inc. =
'= All rights reserved =
'= "Font.INCL" from PG:PRO =
'===============================================================================
INCLUDE FILE _aplIncl
COMPILE 0,_MacsbugLabels_strResource_caseInsensitive'set by PG:PRO
GLOBALS "PG PRO.GLBL"'include standard global file
END GLOBALS'no other globals
GOTO "Font:Start"'ALWAYS jump around functions
INCLUDE "@Header.INCL"
DEFSTR LONG'needed for CVI's
'_______________________________________________________________________________
LOCAL FN checkMinstall(@theVar&)'∑œ∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑œ∑
'—————————————————————————————————————————————————————————————————————————————
theMenuID = {theVar&}
LONG IF theMenuID
LONG IF FN GETMHANDLE(theMenuID) = 0
% theVar&,0
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN suggestFontSize(fNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
temp$ = STR#(_baseID - 4,2)'get name of size menu
sizeMenu = FN pGfindMenu(temp$)'get menu's ID
FN checkMinstall(sizeMenu)'is it installed?
LONG IF sizeMenu'pG built menu?
mHndl& = FN GETMHANDLE(sizeMenu)
LONG IF mHndl&
itemCount = FN COUNTMITEMS(mHndl&)
FOR loop = 1 TO itemCount
CALL GETITEM(mHndl&,loop,theItem$)
theSize = VAL(theItem$)'size is value of item
theMask = 0
LONG IF theSize'numeric item?
LONG IF FN REALFONT(fNum,theSize)'thsi size avail?
theMask = _outlineBit%'use outline
END IF
END IF
CALL SETITEMSTYLE(mHndl&,loop,theMask)
NEXT
END IF
END IF
END FN
'_______________________________________________________________________________
LOCAL FN autoFontMenu'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
menuID = gWhichMenu
itemID = gWhichItem
mHndl& = FN GETMHANDLE(menuID)
LONG IF mHndl&
theTitle$ = PSTR$([mHndl&] + _menuData)
SELECT theTitle$
CASE STR#(_baseID - 4,1)'"Font" menu -----------------
DEF CHECKONEITEM(menuID,gWhichItem)
CALL GETFNUM(gItemName$,fNum)
FN suggestFontSize(fNum)
IF WINDOW(_EFnum) THEN EDIT TEXT fNum
CASE STR#(_baseID - 4,2)'"Size" menu -----------------
theSize = VAL(gItemName$)
LONG IF theSize
DEF CHECKONEITEM(menuID,gWhichItem)
theSize = VAL(gItemName$)
XELSE
temp$ = STR#(_baseID - 5,1)
temp$ = FN pGask$(temp$,"")
theSize = VAL(temp$)
IF theSize < 7 OR theSize>127 THEN theSize = 0
END IF
IF WINDOW(_EFnum) AND theSize>0 THEN EDIT TEXT ,theSize
CASE STR#(_baseID - 4,3)'"Style" menu -----------------
SELECT gWhichItem
CASE 1'plain
theStyle = 0
EDIT TEXT ,,theStyle
CASE <_justifyItem
LONG IF gWhichItem > _justifyItem-4'condense/extend
DEC(gWhichItem)'allow for line before items
END IF
theStyle = (2^(gWhichItem-3))
EDIT TEXT ,,theStyle
CASE ELSE
LONG IF WINDOW(_EFnum)
LONG IF BUTTON&(WINDOW(_EFnum))
oldPos = BUTTON(WINDOW(_EFnum))
XELSE
oldPos = 0
END IF
EDIT FIELD WINDOW(_EFnum),,,,gWhichItem - _justifyItem + 1
IF oldPos THEN SCROLL BUTTON WINDOW(_EFnum),oldPos
END IF
itemCount = FN COUNTMITEMS(mHndl&)
LONG IF itemCount >_justifyItem
FOR loop = _justifyItem TO itemCount
CALL CHECKITEM(mHndl&,loop,(loop = gWhichItem))
NEXT
END IF
END SELECT
END SELECT
END IF
END FN
'_______________________________________________________________________________
LOCAL FN fixFontMenus'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
DIM tsFont,tsFace,tsSize,tsColor;6
temp$ = STR#(_baseID - 4,2)'get name of size menu
LONG IF LEN(temp$)
sizeMenu = FN pGfindMenu(temp$)
XELSE
sizeMenu = 0
END IF
FN checkMinstall(sizeMenu)'is it installed?
temp$ = STR#(_baseID - 4,1)'get name of font menu
LONG IF LEN(temp$)
fontMenu = FN pGfindMenu(temp$)
LONG IF fontMenu'check to see if it's a popper
LONG IF FN GETMHANDLE(fontMenu) = 0
fontMenu = 0
END IF
END IF
XELSE
fontMenu = 0
END IF
FN checkMinstall(fontMenu)'is it installed?
temp$ = STR#(_baseID - 4,3)'get name of style menu
LONG IF LEN(temp$)
styleMenu = FN pGfindMenu(temp$)
XELSE
styleMenu = 0
END IF
FN checkMinstall(styleMenu)'is it installed?
'
theField = WINDOW(_EFnum)'get current field num
LONG IF theField'any active field?
LONG IF WINDOW(24)>0'not a pict field
theMode = _doAll
boolean = FN TECONTINUOUSSTYLE(theMode,tsFont,WINDOW(_EFHandle))
:'== FONT MENU ==
LONG IF fontMenu'pG built menu?
DEF CHECKONEITEM(fontMenu,0)'uncheck all items
LONG IF theMode AND _fontBit%'was a font continuous?
FN suggestFontSize(tsFont)'outline useable sizes
CALL GETFONTNAME(tsFont,temp$)'get font name for font num
FN pGcheckName(fontMenu,temp$)'check this font name
XELSE'no continuous font?
mHndl& = FN GETMHANDLE(sizeMenu)'handle to size menu
LONG IF mHndl&
itemCount = FN COUNTMITEMS(mHndl&)'number of items in menu
FOR loop = 1 TO itemCount-2'loop thru
CALL SETITEMSTYLE(mHndl&,loop,0)'set style to plain
NEXT'till all outlines abolished
END IF
END IF
END IF
:'== SIZE MENU ==
LONG IF sizeMenu'pG built menu?
DEF CHECKONEITEM(sizeMenu,0)'uncheck all items
LONG IF theMode AND _sizeBit%'was a size continuous?
temp$ = MID$(STR$(tsSize),2)+" "+STR#(_baseID-5,3)
FN pGcheckName(sizeMenu,temp$)'check the item name
END IF
END IF
:'== STYLE MENU ==
LONG IF styleMenu'pG built menu?
DEF CHECKONEITEM(styleMenu,0)'uncheck all items
LONG IF theMode AND _faceBit%'is a style cont. over the sel
LONG IF (tsFace AND &6000) = &6000'cond & extend both checked
tsFace = tsFace - &6000'clear these two bits because
END IF'they cancel each otherr
LONG IF tsFace = 0'is that style plain?
MENU styleMenu,1,2'check "Plain" only
XELSE
offSet = 3'1st bit matches 3rd menu item
tsFace = PEEK(@tsFace)'TextEdit only uses hi byte
FOR loop = 0 TO 6'7 possible styles
LONG IF tsFace AND (2^loop)'is this style bit set?
MENU styleMenu,loop + offSet,2'check it
END IF
IF loop = 4 THEN INC(offSet)'allow for line B4 "Condense"
NEXT'complete style item loop
END IF'end of tsFace<>0
END IF'end of continuous face
:
mHndl& = FN GETMHANDLE(styleMenu)
LONG IF mHndl&
LONG IF FN COUNTMITEMS(mHndl&) > _justifyItem
justify = WINDOW(24)-1 AND 3'== JUSTIFICATION ==
MENU styleMenu,justify + _justifyItem,2'check this style
END IF
END IF
END IF
'
END IF
'
END IF
END FN
'_______________________________________________________________________________
LOCAL FN initFonts'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
'—————————————————————————————————————————————————————————————————————————————
temp$ = STR#(_baseID - 4,1)'get name of font menu
LONG IF LEN(temp$)
fontMenu = FN pGfindMenu(temp$)
LONG IF fontMenu
MENU fontMenu,-1,1,"FOND"'add all fonts
CALL GETFONTNAME(1,temp$)'get application font name
FN pGcheckName(fontMenu,temp$)'check it in the menu
mHndl& = FN GETMHANDLE(fontMenu)
LONG IF mHndl&
IF {[mHndl&]} > 99 THEN CALL DELETEMENU({[mHndl&]})
END IF
END IF
END IF
temp$ = STR#(_baseID - 4,2)'get name of size menu
LONG IF LEN(temp$)'pG built menu?
sizeMenu = FN pGfindMenu(temp$)
FN checkMinstall(sizeMenu)'is it installed?
LONG IF sizeMenu
FN suggestFontSize(1)'outline proper sizes
temp$ = STR#(_baseID - 5,2)'get default font size
FN pGcheckName(sizeMenu,temp$)'check 12 pt. in the menu
END IF
END IF
END FN
'_______________________________________________________________________________
'€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ FONT FILTER €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
'———————————————————————————————————————————————————————————————————————————————
"Font:Start"
SELECT gAction
CASE _mouseAction'pass quickly
CASE _mainAction
LONG IF gSubAction = _mainStart
FN initFonts
END IF
CASE _menuAction :FN autoFontMenu
CASE _otherAction
LONG IF gSubAction = _otherBeforeMenu
FN fixFontMenus
END IF
END SELECT